Regression models with R

Das Ziel ist es, aus dem Datacamp Datensatz Video Game Sales Date folgende Fragestellung / Hypothese zu beantworten:

Fragestellung: “Ist es wahrscheinlicher, dass sich bestimmte Spielgenres in Europa signifikant (Unterschied von 50%) besser verkaufen lassen als im Japanischen und Nordamerikanischen Markt?”

Als Einführung werden wir auf Datacamp folgende Kurse durchgehen:

• Introduction to Regression in R

• Intermediate Regression in R

# Import libraries
library("plotly")
library("ggplot2")
library("plyr")
library("dplyr")
library("broom")
library("gridExtra")   

view(df)

Error in view(df) : could not find function "view"

Data Wrangling

Bevor wir mit den Visualisierungen und dem Erstellen der Modelle beginnen können, müssen wir die Daten säubern. Das heisst es sollte keine Duplikate geben, fehlende Werte sollten korrekt eingetragen werden und Daten, die nicht verwendet werden, sollten gelöscht werden.

Es hat “N/A” Werte in den Spalten “Year” und “Publisher”. Diese Werte sollten korrekte “NA” Werte sein, damit sie bei den Visualisierungen und Berechnungen nicht berücksichtigt werden.

# Show rows with "N/A" values
df[grep("N/A", df$Publisher),]

df[grep("N/A", df$Year),]

# Replace "N/A" with "NA"
df[df == "N/A"] <- NA

df <- df %>%
  filter(df$Global_Sales > 0.1)

df

# Check if values have been converted
df %>% 
  summarize(across(everything(), ~sum(is.na(.))))

Da 2017 nur 3 Einträge und 2020 nur 1 Eintrag beinhaltet, werden wir diese Jahren nicht berücksichtigen und aus dem Dataframe löschen. Da diese nicht vollständig sind, könnten unsere Modelle ungenau werden.

# Remove years 2017 and 2020 from dataset
df_clean <- df[!(df$Year == "2017" | df$Year == "2020"),]

# Remove unnecessary columns because they are not needed for our thesis
drop <- c("Rank")
df_clean <- df_clean[,!(names(df_clean) %in% drop)]

df_clean

# Set data to correct type
df_clean$Genre <- as.factor(df_clean$Genre)
df_clean$Year <- as.numeric(df_clean$Year)

Erste Plots erstellen

Wir erstellen ein paar erste Plots um uns einen Überblick über die Daten zu verschaffen.

na <- sum(df_clean[, 'NA_Sales'], na.rm = TRUE)
eu <- sum(df_clean[, 'EU_Sales'], na.rm = TRUE)
jp <- sum(df_clean[, 'JP_Sales'], na.rm = TRUE)
o <- sum(df_clean[, 'Other_Sales'], na.rm = TRUE)
g <- sum(df_clean[, 'Global_Sales'], na.rm = TRUE)

fig <- plot_ly(
  y = c(na, eu, jp, o), 
  x = c("North America", "Europe", "Japan", "Other"), 
  type = 'bar',
  width = 800
)

fig <- fig %>% layout(title = "Video Game Sales Overview",
         xaxis = list(title = "Region"),
         yaxis = list(title = "Sales (million)"))

fig

Anhand dieses Diagrammes, kann man sehen, dass Nordamerika mit Abstand der grösste Absatzmarkt im Game-Bereich ist.

Nun wollen wir noch die Verteilung der verschiedenen Spielgenres besser sehen:

# Group by genre and summarize game sales to each region
df_genre <- df_clean %>%
  group_by(Genre) %>%
  summarize(
    NA_Sales_Sum = sum(NA_Sales),
    EU_Sales_Sum = sum(EU_Sales), 
    JP_Sales_Sum = sum(JP_Sales),
    Other_Sales_Sum = sum(Other_Sales),
    Global_Sales_Sum = sum(Global_Sales)
  )

# Plot grouped bar chart video game sales by genre
fig <- plot_ly(
  df_genre, y = ~Genre, x = ~NA_Sales_Sum, type = "bar", name = "North America", width = 1000, height = 800) %>% 
  add_trace(x = ~EU_Sales_Sum, name = "Europe") %>%
  add_trace(x = ~JP_Sales_Sum, name = "Japan") %>%
  add_trace(x = ~Other_Sales_Sum, name = "Other") %>%
  layout(
    title = "Video Game Sales by Genre",
    xaxis = list(title = "Sales (million)"),
    barmode = "group"
  )

fig

Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations

Hier sieht man gut, dass Japan im Vergleich zu den anderen Märkten viel mehr Role-Play und Strategie Spiele verkauft. Dafür werden in Japan aber viel weniger Shooter und Action Spiele als den anderen Regionen verkauft.

df_year <- df_clean %>%
  group_by(Year) %>%
  summarize(
    NA_Sales_Sum = sum(NA_Sales),
    EU_Sales_Sum = sum(EU_Sales), 
    JP_Sales_Sum = sum(JP_Sales),
    Other_Sales_Sum = sum(Other_Sales),
    Global_Sales_Sum = sum(Global_Sales)
  )

fig <- plot_ly(
  df_year, y = ~NA_Sales_Sum, x = ~Year, type = "bar", name = "North America", width = 900, height = 500) %>% 
  add_trace(y = ~EU_Sales_Sum, name = "Europe") %>%
  add_trace(y = ~JP_Sales_Sum, name = "Japan") %>%
  add_trace(y = ~Other_Sales_Sum, name = "Other") %>%
  layout(
    title = "Video Game from Sales by Year",
    xaxis = list(title = "Year"),
    yaxis = list(title = "Sales (million)"),
    barmode = "stack"
  )

fig

Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations
Warning: Ignoring 1 observations

Überraschenderweise, sieht man in diesem Diagramm, dass die Videospiel Verkäufe zwischen den Jahren 2005 und 2012 geboomt haben. Danach ist die Kurve wieder abgeflacht. Dies könnte unter anderem daran liegen, dass in dieser Zeit viele neue Konsolen auf den Markt gekommen sind, welche grosse Neuerungen mit sich brachten. Die Playstation 3, die Xbox 360 und die Nintendo Wii sind alle in 2005-2006 auf den Markt gekommen und haben den Spielemarkt anscheinend stark beeinflusst.

# Calculate the average of sales of each genre from each region
df_sales_avg <- df_clean %>%
  group_by(Genre) %>%
  summarise(
    EU_Sales_Avg = mean(EU_Sales),
    NA_Sales_Avg = mean(NA_Sales),
    JP_Sales_Avg = mean(JP_Sales),
    Other_Sales_Avg = mean(Other_Sales),
    Global_Sales_Avg = mean(Global_Sales))

df_sales_avg

Hier sehen wir die durchschnittliche Anzhal von Verkäufe pro Genre.

Regressionsmodelle

Da wir unsere Daten jetzt besser verstehen, können wir mit den Regressionsmodellen und mit der Beantwortung unserer Fragestellung beginnen. Allerdings mussten wir feststellen, dass unsere Fragestellung ungeschickt war und wir diese nicht ausreichend beantworten können. Daher haben wir uns folgende Alternativ-Fragestellung überlegt:

Kann man anhand der nordamerikanischen Verkäufe voraussagen, wie sich ein Genre im europäischen Markt verkaufen wird?

Diese Frage könnte einer Firma dabei helfen zu entscheiden, wieviel Werbebudget diese in Europa ausgeben soll, nachdem ein Spiel in Amerika bereits auf den Markt gekommen ist.

Daten optimieren

In unserem Datensatz gibt es einige Ausreisser. Zum Beispiel gibt es Spiele, welche nur in einzelnen Regionen auf den Markt gekommen sind und die in anderen Ländern garnicht verkauft wurden. Diese Tatsache würde beim Erstellen der Modelle zu grossen Abweichungen und Ungenauigkeiten führen. Daher berücksichtigen wir nur die Games, welche über 1 Mio. Verkäufe haben.

Unten haben wir die Genres mit den besten Fits genommen, da bei den anderen Spielgenres der r-squared Wert unter 50% lag. Das bedeutet, dass es dort keinen Zusammenhang gibt, weshalb wir diese ebenfalls nicht beachten werden.

Wir erstellen das Dataframe mit allen Racing Games:

# Create DataFrame only with Racing games
df_racing <- df_clean %>%
  filter(
    Genre == "Racing",
    NA_Sales > 1.00,
    EU_Sales > 1.00
  )

#create scatterplot
ggplot(df_racing, aes(x=EU_Sales, y=NA_Sales)) + 
  geom_point() + 
  geom_smooth(method = "lm", se=FALSE) +
  labs(title = "Racing Game Sales Overview")

`geom_smooth()` using formula 'y ~ x'

# Create linear model
mdl_racing <- lm(EU_Sales ~ NA_Sales, data = df_racing)

# Extract model score
mdl_racing %>%
  glance() %>%
  pull(r.squared)

[1] 0.8686435

# Predict EU Sales for a Racing Game based on NA Sales
predict_racing <- tibble(NA_Sales = 5)
predict(mdl_racing, predict_racing)

       1 
3.891789 

Wenn ein Racing Game in Nord Amerika 5 Millionen Verkäufe aufweist, liegt die Verkaufs-Vorhersage für Europa bei rund 3.9 Millionen. In Amerika sind diese Spiele also beliebter als bei uns in Europa.

# Create DataFrame only with Role-Playing games
df_role <- df_clean %>%
  filter(
    Genre == "Role-Playing",
    NA_Sales > 1.00,
    EU_Sales > 1.00
  )

#create scatterplot
ggplot(df_role, aes(x=EU_Sales, y=NA_Sales)) + 
  geom_point() + 
  geom_smooth(method = "lm", se=FALSE) +
  labs(title = "Role-Playing Game Sales Overview")

`geom_smooth()` using formula 'y ~ x'

# Create linear model
mdl_rp <- lm(EU_Sales ~ NA_Sales, data = df_role)

# Extract model score
mdl_rp %>%
  glance() %>%
  pull(r.squared)

[1] 0.8433709

# Predict EU Sales for a Role-Playing Game based on NA Sales
predict_rp <- tibble(NA_Sales = 5)
predict(mdl_rp, predict_rp)

       1 
3.451286 

# Create DataFrame only with Shooter games
df_shooter <- df_clean %>%
  filter(
    Genre == "Shooter",
    NA_Sales > 0.00,
    EU_Sales > 0.00
  )

# Create DataFrame only with Shooter games without Duck Hunt
df_shooter_no_duckhunt <- df_clean %>%
  filter(
    Genre == "Shooter",
    NA_Sales > 0.00,
    Name != "Duck Hunt",
    EU_Sales > 0.00
  )

# Create subplots
p1 <- ggplot(df_shooter, aes(x=EU_Sales, y=NA_Sales)) + 
  geom_point() + 
  geom_smooth(method = "lm", se=FALSE) +
  labs(title = "Shooter Game Sales")

p2 <- ggplot(df_shooter_no_duckhunt, aes(x=EU_Sales, y=NA_Sales)) + 
  geom_point() + 
  geom_smooth(method = "lm", se=FALSE) +
  labs(title = "Shooter Game Sales no Duck Hunt")

# Plot both plots side by side
grid.arrange(p1, p2, ncol = 2)  

`geom_smooth()` using formula 'y ~ x'
`geom_smooth()` using formula 'y ~ x'

Dies ist ein Vergleich der nordamerikanischen und der europäischen Verkäufen von Shooter-Spielen. Auf dem linken Plot ist ein ganz gewaltiger Ausreisser zu sehen, ganz oben links im Bild. Das ist das Spiel “Duck Hunt”. Wir haben mehr über dieses Spiel recherchiert und herausgefunden, dass dieses Spiel zum Release des Nintendo Entertainment System kurz NES herausgekommen ist. Beim Kauf einer NES gab es das Spiel meistens dazu. Zu dem Zeitpunkt, kam die NES aber erst in Amerika auf den Markt und noch nicht in Europa. Daher sieht man, dass die Verkäufe in Amerika fast bei 30 Mio. lag und in europa sogar weniger als 1 Mio. Einheiten. Im Plot rechts, haben wir diesen Ausreiser entfernt und wir sehen direkt ein viel genaueres Bild.

# Create linear model
mdl_shooter <- lm(EU_Sales ~ NA_Sales, data = df_shooter)

# Extract model score
mdl_shooter %>%
  glance() %>%
  pull(r.squared)

[1] 0.4244135

# Create linear model
mdl_shooter_no_duckhunt <- lm(EU_Sales ~ NA_Sales, data = df_shooter_no_duckhunt)

# Extract model score
mdl_shooter_no_duckhunt %>%
  glance() %>%
  pull(r.squared)

[1] 0.6858556

Wie wir hier anhand der R-Squared sehen, fitted das Modell viel besser ohne Duck Hunt.

Aber da das Modell auch ohne Duck Hunt nicht sehr gut ist, werden wir mit diesem Genre keine Vorhersagen durchführen. Diese währen zu ungenau und wir könnten nicht dahinter stehen.

# Create DataFrame only with Simulation games
df_sim <- df_clean %>%
  filter(
    Genre == "Simulation",
    NA_Sales > 1.00,
    EU_Sales > 1.00
)

ggplot(df_sim, aes(x=EU_Sales, y=NA_Sales)) + 
  geom_point() + 
  geom_smooth(method = "lm", se=FALSE) +
  labs(title = "Simulation Game Sales Overview")

`geom_smooth()` using formula 'y ~ x'

Auf diesem Plot gibt es wieder einen Punkt, der weit weg von den anderen ist. Dies ist jedoch in diesem Fall kein Ausreiser, da hier die Verkäufe von Nordamerika und Europa sehr ähnlich sind. Bei diesem extrem beliebten Spiel handelt es sich übrigens um den Hundesimulator “Nintendogs”. ;-)

# Create linear model
mdl_sim <- lm(EU_Sales ~ NA_Sales, data = df_sim)

# Extract model score
mdl_sim %>%
  glance() %>%
  pull(r.squared)

[1] 0.9233418

# Predict EU Sales for a Simulation Game based on NA Sales
predict_sim <- tibble(NA_Sales = 5)
predict(mdl_sim, predict_sim)

       1 
5.474846 

Wenn ein Simulation Game in NA 5 Million Verkäufe aufweist, liegt die Vorhersage für EU bei 5.4 Millionen.

# Create DataFrame only with Sport games
df_sport <- df_clean %>%
  filter(
    Genre == "Sports",
    NA_Sales > 1.00,
    EU_Sales > 1.00
  )

ggplot(df_sport, aes(x=EU_Sales, y=NA_Sales)) + 
  geom_point() + 
  geom_smooth(method = "lm", se=FALSE) +
  labs(title = "Sport Game Sales Overview")

`geom_smooth()` using formula 'y ~ x'

Hier haben wir wieder ein Spiel, welches sich von den Massen abhebt, aber in Amerika sowie in Europa extrem beliebt war. Es handelt sich natürlich um das Kultspiel “Wii Sports”. Dieses wurde einem auch meistens beim Kauf einer Nintendo Wii Konsole dazu geschenkt.

# Create linear model
mdl_sport <- lm(EU_Sales ~ NA_Sales, data = df_sport)

# Extract model score
mdl_sport %>%
  glance() %>%
  pull(r.squared)

[1] 0.9488926

# Predict EU Sales for a Sport Game based on NA Sales
predict_sport <- tibble(NA_Sales = 5)
predict(mdl_sport, predict_sport)

       1 
4.019965 

Wenn ein Sport Game in NA 5 Million Verkäufe aufweist, liegt die Vorhersage für EU bei 4 Millionen.

Residuenanalyse (zum beurteilen ob das Modell gut ist)

Die Residuen sollten folgende Punkte erfüllen:

• Residuen haben den erwartungswert von 0
• Residuen sind voneinander unabhängig
• Residuen sind normalverteilt

Dies müssen wir nun noch prüfen, um zu bestimmen, ob unsere Vorhersagen verlässlich sind.

# Create Residual Scatterplot

df <- augment(mdl_racing)

ggplot(df, aes(x = 1:nrow(df), y = .resid)) + 
  geom_point() +
  geom_hline(yintercept=0, color="Red") +
  ggtitle("Residuals Model Racing Genre") +
  xlab("")

# Create Residual Histogram (to see if the data is a normal distribution)

ggplot(df_racing, aes(x = mdl_racing$residuals)) + 
  geom_histogram(bins = 30) +
  geom_density(color = "Red") +
  ggtitle("Residuals Model Racing Genre") +
  xlab("residuals")

Mit Hilfe der roten Linie sieht man, dass das Histogramm nicht 100% normalverteilt ist. Es kommt jedoch schon nahe an eie Normalverteilung heran, weshalb wir das so akzeptieren können.

# Create Residual Scatterplot

df <- augment(mdl_rp)

ggplot(df, aes(x = 1:nrow(df), y = .resid)) + 
  geom_point() +
  geom_hline(yintercept=0, color="Red") +
  ggtitle("Residuals Model Role-Playing Genre") +
  xlab("")

# Create Residual Histogram (to see if the data is a normal distribution)

ggplot(df_role, aes(x = mdl_rp$residuals)) + 
  geom_histogram(bins = 30) +
  geom_density(color = "Red") +
  ggtitle("Residuals Model Role-Playing Genre") +
  xlab("residuals")

Auch sieht man, dass das Histogramm nicht 100% normalverteilt ist. Es kommt jedoch schon nahe an eie Normalverteilung heran, weshalb wir das so akzeptieren können.

# Create Residual Scatterplot

df <- augment(mdl_sim)

ggplot(df, aes(x = 1:nrow(df), y = .resid)) + 
  geom_point() +
  geom_hline(yintercept=0, color="Red") +
  ggtitle("Residuals Model Simulation Genre") +
  xlab("")

# Create Residual Histogram (to see if the data is a normal distribution)

ggplot(df_sim, aes(x = mdl_sim$residuals)) + 
  geom_histogram(bins = 30) +
  geom_density(color = "Red") +
  ggtitle("Residuals Model Simulation Genre") +
  xlab("residuals")

Mit Hilfe der roten Linie sieht man, dass das Histogramm nicht 100% normalverteilt ist. Es kommt jedoch schon nahe an eie Normalverteilung heran, weshalb wir das so akzeptieren können.

# Create Residual Scatterplot

df <- augment(mdl_sport)

ggplot(df, aes(x = 1:nrow(df), y = .resid)) + 
  geom_point() +
  geom_hline(yintercept=0, color="Red") +
  ggtitle("Residuals Model Sport Genre") +
  xlab("")

# Create Residual Histogram (to see if the data is a normal distribution)

ggplot(df_sport, aes(x = mdl_sport$residuals)) + 
  geom_histogram(bins = 50) +
  geom_density(color = "Red") +
  ggtitle("Residuals Model Sport Genre") +
  xlab("residuals")

Mit Hilfe der roten Linie sieht man, dass das Histogramm nicht 100% normalverteilt ist. Es kommt jedoch schon nahe an eie Normalverteilung heran, weshalb wir das so akzeptieren können.

Wie ähnlich sind sich die Verkaufszahlen von Nordamerika und Europa? Und wie verhalten sich die japanischen Verkaufszahlen im Vergleich zu den zwei westlichen Absatzmärkten?

# Color the SPLOM of NA_Sales, EU_Sales, and JP_Sales by nintendo
df_clean %>%
  plot_ly(color = ~Genre) %>% 
  add_trace(
    type = 'splom',
    dimensions = list(
      list(label = 'N. America', values = ~NA_Sales),
      list(label = 'Europe', values = ~EU_Sales),    
      list(label = 'Japan', values = ~JP_Sales)       
    )
  )

Warning in RColorBrewer::brewer.pal(N, "Set2") :
  n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors

Warning in RColorBrewer::brewer.pal(N, "Set2") :
  n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors

Warning in RColorBrewer::brewer.pal(N, "Set2") :
  n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors

Warning in RColorBrewer::brewer.pal(N, "Set2") :
  n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors

Äusserst spannend zu sehen ist, dass sich grosse Unterschiede sehen lassen, wie sich bestimmte Genre verkauft haben. Die geographische Lage von dem Absatzmarkt ist dabei eher zweitrangig. Mit Abstand am häufigsten wurden Action Spiele verkauft.

Verkaufen sich Nintendo Spiele weltweit besser als Spiele Electronic Arts.

Dafür müssen wir zuerst unser Dataframe Filtern, damit wir nurnoch Spiele von Nintendo und Electronic Arts haben.

# Create DataFrame with only Nintendo and Sony as Publisher
publishers = c("Nintendo", "Electronic Arts")

df_publisher <- df_clean %>%
  filter(
    Publisher %in% publishers
    )

df_publisher

# Replace publisher name with 0 and 1
df_publisher$Publisher[df_publisher$Publisher == "Electronic Arts"] <- 0
df_publisher$Publisher[df_publisher$Publisher == "Nintendo"] <- 1

# Save as int
df_publisher$Publisher <- as.numeric(df_publisher$Publisher)

# Create logistic model
mdl_publisher <- glm(Publisher ~ NA_Sales, data = df_publisher, family = binomial())

ggplot(df_publisher, aes(x=Global_Sales, y=Publisher)) + 
  geom_point(alpha=.5, color="Blue") +
  stat_smooth(method="glm", col = "Red", se=FALSE, method.args = list(family=binomial)) +
  labs(
    x = "Sales (million)",
    y = "1=Nintendo / 0=Electronic Arts",
    title = "Probability that a game is from Nintendo based on global sales"
  )

`geom_smooth()` using formula 'y ~ x'

Wir können hier gut sehen, dass Nintendo viel erfolgreichere Spiele produziert hat. Dies deutet auch an, dass Nintendo beliebter ist als Electronic Arts.

Verkaufen sich in Japan Nintendo Wii Spiele besser als Nintendo DS Spiele?

Nun filtern wir zuerst unseren Dataframe nach Wii und nach DS Spielen.

# Create DataFrame with only Wii and DS as Platforms
platforms = c("Wii", "DS")

df_platform <- df_clean %>%
  filter(
    Platform %in% platforms
    )

df_platform

# Replace platform name with 0 and 1
df_platform$Platform[df_platform$Platform == "Wii"] <- 0
df_platform$Platform[df_platform$Platform == "DS"] <- 1

# Save as int
df_platform$Platform <- as.numeric(df_platform$Platform)

# Create logistic model
mdl_platform <- glm(Platform ~ JP_Sales, data = df_platform, family = binomial())

ggplot(df_platform, aes(x=JP_Sales, y=Platform)) + 
  geom_point(alpha=.2, color="Blue") +
  stat_smooth(method="glm", col = "Red", se=FALSE, method.args = list(family=binomial)) +
  labs(
    x = "Sales (million)",
    y = "1=Wii / 0=DS",
    title = "Probability that a game is from Wii based on sales in Japan"
  )

`geom_smooth()` using formula 'y ~ x'

Anhand von diesem Plot kann man erkennen, dass ein Spiel, welches sich über 2 Mio. mal verkauft hat, eher über die Platform Wii verkauft wurde. Daraus könnte man deuten, dass die Nintendo Wii in Japan beliebter ist als der Nintendo DS.

Fazit

Bei den meisten Genren ist es nicht möglich die Verkäufe in Europa anhand der Verkäufe in Nord Amerika vorherzusagen. Wir haben jedoch einige Genren gefunden, bei denen Vorhersagen möglich ist:

• Racing / Rennspiele
• Role-Playing / Rollenspiele
• Simulation / Simulationsspiele
• Sport / Sportspiele

Sehr interessant zu sehen war das Genre Simulation. Unser Modell, welches bei 92% Genauigkeit liegt sagt voraus, dass ein beliebiges Spiel in Europa besser verkauft wird als in Nord Amerika. Bei allen anderen Genren verkaufen sich die Spiele in Nord Amerika besser.